(module interp (lib "eopl.ss" "eopl")
  
  (require "drscheme-init.scm")

  (require "lang.scm")
  (require "data-structures.scm")
  (require "environments.scm")

  (provide value-of-program value-of)

;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;

  ;; value-of-program : program -> expval

  (define value-of-program 
    (lambda (pgm)
      (cases program pgm
        (a-program (body)
          (value-of body (init-env))))))

  ;; value-of : expression * environment -> expval

  (define value-of
    (lambda (exp env)
      (cases expression exp

        (const-exp (num) (num-val num))

        (var-exp (var) (apply-env env var))

        (diff-exp (exp1 exp2)
          (let ((val1
		  (expval->num
		    (value-of exp1 env)))
                (val2
		  (expval->num
		    (value-of exp2 env))))
            (num-val
	      (- val1 val2))))
        
        (zero?-exp (exp1)
	  (let ((val1 (expval->num (value-of exp1 env))))
	    (if (zero? val1)
	      (bool-val #t)
	      (bool-val #f))))

        (if-exp (exp0 exp1 exp2) 
          (if (expval->bool (value-of exp0 env))
            (value-of exp1 env)
            (value-of exp2 env)))

        (let-exp (idents r-vals body)                  
                 (letrec
                     ((extend-let-env
                       (lambda (ids r-vals s-env)
                         (if (null? ids)
                             s-env
                             (let ((val (value-of (car r-vals) s-env)))
                               (let ((new-env (extend-env 
                                               (car ids) 
                                               val 
                                               s-env)))                                 
                                 (extend-let-env (cdr ids) (cdr r-vals) new-env)))))))
                   (value-of body (extend-let-env idents r-vals env)))
                 )


        (proc-exp (types bvars body)
          (proc-val
            (procedure bvars body env)))

        (call-exp (rator rands)          
                 (let ((proc (expval->proc (value-of rator env)))
                       ;;(arg  (value-of rand env)) --old style single arg
                       (args (letrec 
                                 ((get-value-list
                                   (lambda (arguments senv)
                                     (if (null? arguments) 
                                         ()
                                         (cons (value-of (car arguments) senv) 
                                                (get-value-list (cdr arguments) senv))))))
                                  (get-value-list rands env)))
                             )
                       (apply-procedure proc args)))

        ;;list-exp cons-exp car-exp cdr-exp null-exp emptylist-exp
        (list-exp (e1 es)
                  (letrec 
                      ((value-of-list-exps
                        (lambda (e1 es)
                          (let ((v1 (value-of e1 env)))
                            (if (null? es)
                                (list v1)
                                (cons v1 (value-of-list-exps (car es) (cdr es))))))))
                    (value-of-list-exps e1 es)))
        
        (cons-exp (e1 e2)
                  (list (value-of e1 env) (value-of e2 env)))
        
        (car-exp (expressions)
                 (value-of (car expressions) env))
        
        (cdr-exp (expressions)
                 (let ((exps (cdr expressions)))
                 (letrec
                     ((value-of-cdr-ex
                      (lambda (exps)
                      (if (null? exps)
                          '()
                       (let ((v1 (value-of  (car exps) env)))
                            (cons v1 (value-of-cdr-ex (cdr exps))))))))
                 (value-of-cdr-ex exps))
                 ))
        
        (null-exp (expression)
                  (let ((val (value-of expression env)))
                    (if (null? val) 
                        (bool-val #t)
                        (bool-val #f))))
        
        (emptylist-exp (types)
                       ())
                  
        (letrec-exp (ty1 proc-name bvar ty2 proc-body letrec-body)
          (value-of letrec-body
            (extend-env-recursively proc-name bvar proc-body env)))

	    )))

  ;; apply-procedure : procedure * expval -> expval

  (define apply-procedure
    (lambda (proc1 arg)
      (cases proc proc1
        (procedure (var body saved-env)
          (value-of body (extend-env var arg saved-env))))))
  
  )